green <- miscgis::miscgis_pals$tableau_cat[["green"]]
blue <- miscgis::miscgis_pals$tableau_cat[["blue"]]
orange <- miscgis::miscgis_pals$tableau_cat[["orange"]]
red <- miscgis::miscgis_pals$tableau_cat[["red"]]
teal <- miscgis::miscgis_pals$tableau_cat[["teal"]]
pal_rgb_4 <- miscgis::miscgis_pals$tableau_cat[c("red","gold","green","blue")] %>% unlist %>% palette()
pal_rgb_4 <- miscgis::miscgis_pals$tableau_cat[c("red","gold","green","blue")] %>% unlist %>% palette()
pal_rgb_6 <- miscgis::miscgis_pals$tableau_cat[c("red","gold","green","blue","orange","purple")] %>% unlist %>% palette()
pal_rgb_6 <- miscgis::miscgis_pals$tableau_cat[c("red","gold","green","blue","orange","purple")] %>% unlist %>% palette()

Seattle Boundary

if(!file.exists(root_file('1-data/4-interim/seattle-sf.rds'))){
        tigris::places(state = "WA") %>%
                tigris::filter_place(place = "Seattle") %>%
                spTransform(CRSobj = crs_proj) %>% 
                st_as_sf() %>% 
                miscgis::coerce_to_geom(sf::st_multipolygon) %>% 
                write_rds(root_file('1-data/4-interim/seattle-sf.rds'))
        
}
sea_sf <- read_rds(root_file('1-data/4-interim/seattle-sf.rds'))
green <- miscgis::miscgis_pals$tableau_cat[["green"]]
myLfltGrey(data = as(sea_sf,'Spatial')) %>% 
        myLfltOpts() %>% 
        addPolygons(color = green,opacity = 1,fillColor = green,fillOpacity = .5)

King County Subdivision Boundary

if(!file.exists(root_file('1-data/4-interim/seattle-ccd-sf.rds'))){
        tigris::county_subdivisions(state = "53",county = "033") %>% 
                subset(NAME == "Seattle") %>% 
                spTransform(CRSobj = crs_proj) %>% 
                st_as_sf() %>% 
                miscgis::coerce_to_geom(sf::st_multipolygon) %>% 
                write_rds(root_file('1-data/4-interim/seattle-ccd-sf.rds'))
}
sea_ccd_sf <- read_rds(root_file('1-data/4-interim/seattle-ccd-sf.rds'))
myLfltGrey(data = as(sea_ccd_sf,'Spatial')) %>% 
        myLfltOpts() %>% 
        addPolygons(color = blue,opacity = 1,fillColor = blue,fillOpacity = .5)

Tracts in King County

Although this assessment is primarily focused on three communities within the Seattle CCD subdivision of King County, one of the indicators (housing market conditions) uses neighboring tracts to determine displacement risk. Some of the neighboring tracts are part of other county subdivision, but rather than targeting just those specific tracts, this method collects data for all King County tracts and then runs the analysis on the appropriate subsets.

In the absence of a straight-forward method for identifying all the census tracts in the Seattle CCD subdivision of King County, it is possible to extract this information from American Factfinder. This tutorial describes how to use the American Factfinder interface to extract a list of all “all tracts within (or partially within) a census place”; substituting “county subdivision” for “place” will retrieve the desired results.

if(!file.exists(root_file('1-data/4-interim/tr-kc-wtr-sf.rds'))){
        
        # All KC tracts
        tr_kc_wtr_sf <-
                tigris::tracts(state = '53',county = '033', year = 2014) %>%
                spTransform(CRSobj = crs_proj) %>% 
                st_as_sf() %>% 
                miscgis::coerce_to_geom(sf::st_multipolygon) 
       
         # Seattle CCD tracts 
         # Note: because this selection includes all tracts "within or partially-within" the Seattle CC,
         # several tract GEOIDs are duplicated in the selection. For the sake of clarity, these duplicates
         # are removed from the final vector of GEOIDs.
        tr_ccd_geoid <- 
                read_csv(
                        root_file('1-data/3-external/manual/seattle-ccd/ACS_12_5YR_B01001/ACS_12_5YR_B01001_with_ann.csv'), 
                        col_types = cols(Id2 = col_character()), 
                        skip = 1) %>% 
                mutate(NEW_GEOID1 = str_sub(Id2,1,5),
                       NEW_GEOID2 = str_sub(Id2,16,21),
                       GEOID = paste0(NEW_GEOID1,NEW_GEOID2),
                       UNIQUE = !duplicated(GEOID)) %>%
                filter(UNIQUE) %>% 
                select(GEOID) %>% unlist(use.names = F)
        
        # Create a county Seattle CCD subdivision column and save
        tr_kc_wtr_sf %>% 
                mutate(SEACCD_LGL = ifelse(GEOID %in% tr_ccd_geoid,TRUE,FALSE)) %>% 
                write_rds(root_file('1-data/4-interim/tr-kc-wtr-sf.rds'))
}
tr_kc_wtr_sf <- read_rds(root_file('1-data/4-interim/tr-kc-wtr-sf.rds'))
show_tr_ccd_wtr_sf <- function(){
        
        seaccd <- tr_kc_wtr_sf %>% filter(SEACCD_LGL)
        other_kc <- tr_kc_wtr_sf %>% filter(!SEACCD_LGL)
        
        myLfltGrey() %>% 
                myLfltOpts() %>% 
                addPolygons(data = as(seaccd,"Spatial"),weight = .5,color = blue,opacity = 1,fillColor = blue,fillOpacity = .5) %>% 
                addPolygons(data = as(other_kc,"Spatial"),weight = .5,color = orange,opacity = 1,fillColor = orange,fillOpacity = .5)
}
show_tr_ccd_wtr_sf()

Puget Sound Waterbodies

These are useful for “clipping” census geographies whose boundaries extend into waterbodies.

if(!file.exists(root_file('1-data/4-interim/wtr-sf.rds'))){
        fp_wtr <- root_file('1-data/3-external/NHDMajor.gdb')
# check if the file already exists, if not then download it
if(!file.exists(fp_wtr)){
        
        url <- "ftp://www.ecy.wa.gov/gis_a/inlandWaters/NHD/NHDmajor.gdb.zip" # save the URL for the waterbodies data
        
        temp <- tempfile() # create a temporary file to hold the compressed download
        
        download(url, dest = temp, mode="wb") # download the file
        
        unzip (temp, exdir = root_file('1-data/3-external/')) # extract the ESRI geodatabase file to a project folder
}
wtr_sp <-
        suppressWarnings(readOGR(dsn = fp_wtr,      # create a waterbodies shape
                layer = "NHD_MajorWaterbodies",verbose = FALSE,pointDropZ = TRUE)) %>%
        gBuffer(byid=TRUE, width=0) %>% # clean up self-intersecting polygons
        spTransform(CRSobj = crs_proj)  # transform the projection to match the project projection
wtr_sf <-  
        wtr_sp %>% 
        st_as_sf() %>% 
        miscgis::coerce_to_geom(st_multipolygon)
wtr_sf %>% 
        st_intersects(x = sea_ccd_sf,y = .) %>% 
        unlist(use.names = F) %>% 
        wtr_sf[.,] %>% 
        write_rds(root_file('1-data/4-interim/wtr-sf.rds'))
}
wtr_sf <- read_rds(root_file('1-data/4-interim/wtr-sf.rds'))
show_wtr <- function(){
        myLfltGrey(data = as(wtr_sf,'Spatial')) %>% 
                myLfltOpts() %>% 
                addPolygons(color = blue, opacity = 1, 
                            weight = .5, fillColor = blue,fillOpacity = .5)        
}
show_wtr()

KC Tracts Without (Western) Waterbodies

if(!file.exists(root_file('1-data/4-interim/tr-kc-sf.rds'))){
        tr_kc_wtr_sf %>% 
                filter(TRACTCE %!in% '990100') %>% # remove the Puget Sound tract
                mutate(geometry = st_difference(geometry,st_union(wtr_sf))) %>% 
                coerce_to_geom(st_multipolygon) %>% 
                write_rds(root_file('1-data/4-interim/tr-kc-sf.rds'))
}
tr_kc_sf <- read_rds(root_file('1-data/4-interim/tr-kc-sf.rds'))
show_tr_kc_sf <- function(){
        
        seaccd <- tr_kc_sf %>% filter(SEACCD_LGL)
        other_kc <- tr_kc_sf %>% filter(!SEACCD_LGL)
        
        myLfltGrey() %>% 
                myLfltOpts() %>% 
        addPolygons(data = as(seaccd,"Spatial"),weight = .5,color = blue,opacity = 1,fillColor = blue,fillOpacity = .5) %>% 
        addPolygons(data = as(other_kc,"Spatial"),weight = .5,color = orange,opacity = 1,fillColor = orange,fillOpacity = .5)
}
show_tr_kc_sf()

King County Without (Western) Waterbodies

if(!file.exists(root_file('1-data/4-interim/kc-sf.rds'))){
        tigris::counties(state = '53', cb = TRUE) %>% 
                st_as_sf() %>% 
                st_transform(crs_proj@projargs) %>% 
                filter(NAME %in% 'King') %>% 
                miscgis::coerce_to_geom(sf::st_multipolygon) %>% 
                mutate(geometry = st_difference(geometry,st_union(wtr_sf))) %>% 
                write_rds(root_file('1-data/4-interim/kc-sf.rds'))
        
}
kc_sf <- read_rds(root_file('1-data/4-interim/kc-sf.rds'))